MACD 5/MACD 5.bin/workbench/wb/czesc_1/batchman/code/batchman.mod

Text File | 1990-02-27 | 5KB | 204 lines

(* Copyright 1988 Michal Todorovic *)
(* For non commercial use only.    *)

MODULE Batchman;

FROM System         IMPORT StackSize, argc;
FROM Strings        IMPORT ConcatString, StringLength;
FROM Intuition      IMPORT WindowPtr, GadgetPtr,
                           IntuiMessagePtr, IDCMPFlagsSet,
                           ActivateGadget, GadgetUp,
                           Closewindow, RefreshGList,
                           NewSize, StringInfoPtr;
FROM Ports          IMPORT MessagePtr, WaitPort, GetMsg,
                           ReplyMsg;
FROM TermInOut      IMPORT WriteString, WriteCard, WriteLn;
FROM AmigaDOS       IMPORT Execute;
FROM BatchIntuition IMPORT OpenWin, CloseWin, SetUpGadgets;
FROM SimpleGadgets  IMPORT FreeGadgetList;
FROM DosStuff       IMPORT LongString, ShortString, GetInfo,
                           MaxGadgets;
FROM SYSTEM         IMPORT ADR, BYTE, ADDRESS;

TYPE
  LongStringPtr = POINTER TO LongString;


VAR
  Win      : WindowPtr;
  Gad      : GadgetPtr;
  Paths    : ARRAY [0..MaxGadgets] OF LongString;
  Names    : ARRAY [0..MaxGadgets] OF ShortString;
  Text     : LongString;
  Memory   : ARRAY [0..MaxGadgets] OF CHAR;
  Num      : CARDINAL;
  Check    : BOOLEAN;
  Top      : INTEGER;



(**********************************************************)
(* Sets up the window and gadgets.                        *)
(* I know it uses all global variables.                   *)
(**********************************************************)
PROCEDURE SetUpIntuition();

BEGIN
  Top := 50;
  Gad := SetUpGadgets(Num, Names, Top);
  IF Gad = NIL THEN
    WriteString("\n\nUh Oh... Out of memory!\n\n");
    HALT
  END;
  Top := Top + 14;
  OpenWin(Win, Gad, Top);
  IF Win = NIL THEN
    FreeGadgetList(Gad^);
    WriteString("\n\nUh Oh... Out of memory!\n\n");
    HALT
  END
END SetUpIntuition;



(**********************************************************)
(* Executes the DOS commands.                             *)
(**********************************************************)
PROCEDURE Process(ID        : CARDINAL;
                  VAR Check : BOOLEAN);

VAR
  Command : ARRAY [0..255] OF CHAR;
  X       : CARDINAL;
  Right   : BOOLEAN;

BEGIN
  IF ((CAP(Memory[ID])='R') OR (CAP(Memory[ID])='Q')) THEN
    Command := "C:Execute ";
    ConcatString(Command, Paths[ID]);
    ConcatString(Command, " ");
    ConcatString(Command, Text)
  ELSE
    FOR X := 0 TO 100 DO
      Command[X] := Paths[ID][X]
    END;
    ConcatString(Command, " ");
    ConcatString(Command, Text)
  END;
  Right := Execute(ADR(Command), 0, 0);
  Check := (CAP(Memory[ID]) = 'Q');
  WriteLn()
END Process;




(**********************************************************)
(* Processes the intuition events                         *)
(**********************************************************)
PROCEDURE ProcessGadgets();

VAR
  Check,
  Dummy      : BOOLEAN;
  MsgPtr     : IntuiMessagePtr;
  Class      : IDCMPFlagsSet;
  CurrentGad,
  StringGad  : GadgetPtr;
  Counter,
  ID         : CARDINAL;
  SPtr       : StringInfoPtr;
  Temp       : LongStringPtr;

BEGIN
  Check := FALSE;
  StringGad := Gad;
  (* Find the string gadget. *)
  WHILE (StringGad^.NextGadget <> NIL) DO
    StringGad := StringGad^.NextGadget
  END;

  REPEAT
    Dummy  := ActivateGadget(StringGad^,Win^,NIL);
    MsgPtr := WaitPort(Win^.UserPort^);
    LOOP
      IF Win <> NIL THEN
        MsgPtr := GetMsg(Win^.UserPort^)
      ELSE
        EXIT
      END;
      IF (MsgPtr = NIL) THEN
        EXIT
      END;
      Class      := MsgPtr^.Class;
      CurrentGad := MsgPtr^.IAddress;
      ReplyMsg(MessagePtr(MsgPtr));

      IF (Class = IDCMPFlagsSet{GadgetUp}) THEN
        (* if you pressed a gadget *)

        ID   := CurrentGad^.GadgetID;
        SPtr := StringInfoPtr(StringGad^.SpecialInfo);
        Temp := LongStringPtr(SPtr^.Buffer);
        Text := Temp^;

        CloseWin(Win);
        FreeGadgetList(Gad^);
        Win := NIL;
        Gad := NIL;

        Process(ID, Check);

        IF NOT(Check) THEN
          SetUpIntuition();
          StringGad := Gad;
          (* Find the string gadget. *)
          FOR Counter := 1 TO Num DO
            StringGad := StringGad^.NextGadget
          END;
        END
      ELSIF (Class = IDCMPFlagsSet{Closewindow}) THEN
        (* You want to quit already??!! *)
        Check := TRUE
      ELSIF (Class = IDCMPFlagsSet{NewSize}) THEN
        RefreshGList(Gad^, Win^, NIL, -1)
      ELSE
        (* What intuition event? *)
        EXIT
      END
    END
  UNTIL Check;
END ProcessGadgets;





(*-------MAIN-------*)
BEGIN
  IF StackSize < 8000D THEN
    WriteString("\n\nStack is too small.  Set to 8000.\n\n");
    HALT
  END;

  Check := TRUE;
  Top   := 50;
  Win   := NIL;
  Gad   := NIL;
  Check := GetInfo(Paths, Names, Memory, Num);
  IF Check THEN
    SetUpIntuition();
    ProcessGadgets()
  ELSE
    (* Configuration file syntax boo boo. *)
    WriteString("\n\nError in file on line #");
    WriteCard(Num, 2);
    WriteLn
  END;

  CloseWin(Win);
  IF Gad <> NIL THEN
    FreeGadgetList(Gad^)
  END
END Batchman.